home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / mail / metamail / contrib / ServiceMail / src / shell / _bogo.tcl next >
Encoding:
Text File  |  1993-03-15  |  1.7 KB  |  70 lines
  1. set boundindex 1
  2.  
  3. proc bogo__bogo_ {switches envelope inputs} {
  4.     global boundindex
  5.     set fname "| _bin_/lcat _spooldir_/services._bogo_"
  6.     if {[catch "set fid [open $fname w]"]==0} {
  7.       dumpenv $envelope $fid
  8.       dumpbody $inputs $fid
  9.     close $fid
  10. }
  11. }
  12.  
  13. proc dumpenv {envelope fid} {
  14.       set size [llength $envelope]
  15.       set size [expr $size/2]
  16.       puts $fid "From [getfield $envelope FROM] Thu Jan 01 00:00:00 1970"
  17.       for {set i 0} {$i<=$size} {incr i} {
  18.         if {[string length [lindex $envelope [expr {$i*2}]]]==0} continue
  19.         puts $fid [lindex $envelope [expr {$i*2}]] nonewline
  20.         puts $fid ": " nonewline
  21.         puts $fid [lindex $envelope [expr {$i*2+1}]]
  22.       }
  23.       puts $fid ""
  24. }
  25.  
  26. proc dumpbody {inputs fid} {
  27.   global boundindex 
  28.   puts $fid "Content-Type: " nonewline
  29.   if {[getfield $inputs TYPE]=="multipart"} {
  30.     set parts [getfield $inputs PARTS]
  31.     set size [expr {[llength $parts]-1}]
  32.     incr boundindex
  33.     set boundary mumblemumble$boundindex
  34.     puts $fid multipart/ nonewline
  35.     puts $fid [getfield $inputs SUBTYPE]\;
  36.     puts $fid "  boundary=\"$boundary\""
  37.     for {set i 0} {$i<=$size} {incr i} {
  38.       puts $fid --$boundary
  39.       dumpbody [lindex $parts $i] $fid
  40.     }
  41.     puts $fid --$boundary--
  42.     puts $fid ""
  43.   } else {
  44.     puts $fid [getfield $inputs TYPE]/[getfield $inputs SUBTYPE]
  45.     puts $fid ""
  46.     if {[catch "set fd2 [open [getfield $inputs FILE] r]"]==0} {
  47.       for {} {1} {} {
  48.         set tmp [gets $fd2]
  49.         if {$tmp == ""} {
  50.           if {[eof $fd2] == 1} {
  51.             close $fd2
  52.             break
  53.           }
  54.         }
  55.         puts $fid $tmp
  56.       }
  57.     } else {
  58.     puts $fid ""
  59.     }
  60.   }
  61. }    
  62.       
  63.  
  64.   
  65.   
  66.  
  67.       
  68.       
  69.     
  70.